#!/usr/bin/perl

# Подключим основные модули
use strict;
use warnings;
use Switch;
# Подключим модули для работы с веб-сервером
use HTTP::Request::Common qw(POST);
use LWP::UserAgent;

# Системные настройки скрипта: url - домен сайта intv (вдруг поменяют), agent - то, с каким именем перл скрипт к серверу на поклон пойдет
my $url = 'intv.ru';
my $agent = 'Mozilla/5.0 (X11; U; Linux x86_64; en-US; rv:1.9.1.1) Gecko/20090718 Shiretoko/3.5.1';

# Настройки дефолтных переменных (не рекомендую их изменять)
my $saveto = 'f';
my $filename = 'film_links.txt';

my $res_content = shift;

sub grab_video{
   print "Trying to get page content...\n";
   
   # Создадим новое подключение к серверу по протоколу HTTP (можно было и через сокеты, но так как-то спокойнее)
   my $ua = LWP::UserAgent->new;
   # Скажем ему называться не перлоботом, а например мозиллой файрфокс
   $ua->agent($agent);
   # Получим код начальной страницы (на которую пользователь скормил нам ссылку)
   my $req = HTTP::Request->new(GET=>'http://'.$url.'/'.$_[0]);
   my $res = $ua->request($req);
   my $line = $res->content;

   print "Trying to get links...\n";
   # Пытаемся распарсить строчку с флешкой, если что поменяется, то там должно быть нечто подобное: SWFObject("http://flash.intv.ru/uplayer.swf?id=3D479vpUnw
   if($line =~ /SWFObject\(\"(.*?uplayer\.swf\?id\=)(.*?)\"/){
	  # Теперь получим список id'шников фильмов (если их много), хедер 'reherer' - обязателен (видимо маленькая хитрость разработчика от таких же хитрых разработчиков)
	  $req = HTTP::Request->new(POST=>'http://flv.intv.ru/watch/playinfo.php', HTTP::Headers->new(reherer => "http://intv.ru"));
	  $req->content_type('application/x-www-form-urlencoded');
	  # В POST-переменных передаем изначальный id, который мы получили при разборе строки с .swf
	  $req->content("id=$2");
	  $res = $ua->request($req);
	  my $playinfo = $res->content;
	  # Инициализируем новый массив, для хранения имен фильмов
	  my @film_names;
	  my $cnt = 0;
	  # Соберем в массив все id'шники и имена из полученого ответа в XML формате
	  # Можно было воспользоваться классом XML, но это из пушки по воробьям: придется ставить из cpan'а доп модули,
	  # А регуляркой это дело разбирается одной строкой
	  while ($playinfo =~ /\<title\>\<\!\[CDATA\[(.*?)\]\]\>\<\/title\>.*?\<id\>(.*?)\<\/id\>/simg){
		 push(@film_names, $1);
		 # Теперь получим непосредственно ссылки на фильмы из полученых ранее их id'шников
		 $req = HTTP::Request->new(POST=>'http://flv.intv.ru/watch/reg.php', HTTP::Headers->new(reherer => "http://intv.ru"));
		 $req->content_type('application/x-www-form-urlencoded');
		 $req->content("id=$2");
		 $res = $ua->request($req);
		 my $reg = $res->content;
		 # Распарсим ссылки и приступим непосредственно к формированию конечного документа
		 if($reg =~ /\<\!\[CDATA\[(.*?)\]\]\>/msi){
				 switch($saveto){
					 case /l/ {
						 $res_content .= "<li><a href=\"$1\">$film_names[$cnt]</a></li>";
					 }
					 case /h/ {
						 $res_content .= '<div><h3><a href="#">'.$film_names[$cnt].'</a></h3><div><embed type="application/x-shockwave-flash" src="http://www.stepashka.com/player/player.swf" id="mpl" name="mpl" quality="high" allowfullscreen="true" flashvars="file='.$1.'&height=470&width=600&location=player.swf &showdigits=true&bufferlength=7&shownavigation=true&type=flv&usekeys=false" height="470" width="600"></div></div>';
					 }
					 else {
						 $res_content .= "$1\n";
					 }
				 }
			
			$cnt++;
		 }
	  }
	  switch($saveto){
		 case /l/ {
			open(TPL, "./template/forlinks.tpl") or die "Can not open template file: $!";
				 my $c;
				 while(<TPL>){
					 $_ =~ s/\{films\}/$res_content/gsim;
					 $c .= $_;
				 }
				 $res_content = $c;
				 close(TPL);
		 }
		 case /h/ {
			open(TPL, "./template/forflash.tpl") or die "Can not open template file: $!";
				 my $c;
				 while(<TPL>){
					 $_ =~ s/\{films\}/$res_content/gsim;
					 $c .= $_;
				 }
				 $res_content = $c;
				 close(TPL);
		 }
	  }
	  
	  open(OP, "> $filename") or die "Error opening file '$filename': $!";
	  print OP $res_content;
	  close(OP);
	  print "All records saved to '$filename'";
		 
	  if(length(@film_names) > 0){
		 print "\nAll operations complete! Press Enter to exit\n";
		 my $exit = <STDIN>;
	  }
	  else{
		 print "\nError in parser! Fix errors and start script again. Press Enter to exit\n";
		 my $exit = <STDIN>;
	  }
   }
}

sub init{
   print 'Please, provide link to film: ';
   my $link = <STDIN>;
   if($link =~ /^(http\:\/\/){0,}intv\.ru(.*?)$/i){
      $link = $2;
      print 'How to save links (type "help" to print help)? [default: f]: ';
      $saveto = <STDIN>;
      if($saveto =~ /help/){
         print "\ttype l to save to html links\n\ttype f to save links to text file\n\ttype h to save to html links with flash\n";
         $saveto = 'f';
         print 'How to save links? [default: f]: ';
         my $tmp = <STDIN>;
         if($tmp =~ /[lfh]/){
            $saveto = $tmp;
         }
      }
      print 'Please provide filename [default: film_links.txt]: ';
      my $tmp = <STDIN>;
      $tmp =~ s/[\n\r]//sim;
      $filename = length($tmp) < 1 ? $filename : $tmp;
      &grab_video($link);
   }
   else{
      print "Illigal URL\n";
   }
}

&init;